perm filename FILLER.SAI[PUB,TES]3 blob
sn#077424 filedate 1973-12-10 generic text, type T, neo UTF8
00100 ENTRY TEXTLINE ;
00200 BEGIN "FILLER"
00300
00400 DEFINE TERNAL = "EXTERNAL" , PRELOAD = "COMMENT" ;
00500 REQUIRE "PUBDFS.SAI" SOURCE_FILE ;
00600 REQUIRE "PUBMAI.SAI" SOURCE_FILE ;
00700 BEGIN "INNER BLOCK"
00800 REQUIRE "PUBINR.SAI" SOURCE_FILE ;
00900 REQUIRE "PUBPRO.SAI" SOURCE_FILE ;
01000
01100 comment, the following EXTERNAL SIMPLE PROCEDUREs are INTERNAL in PARSER.SAI ;
01200
01300 EXTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL) ;
01400
01500 EXTERNAL RECURSIVE STRING PROCEDURE PASS ;
01600
01700 EXTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
01800
01900 EXTERNAL STRING SIMPLE PROCEDURE VEVAL ;
02000
02100 EXTERNAL STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;
02200
02300 EXTERNAL SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH) ; TES 11/15/73 ;
02400
02500 FORWARD RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;
02600
02700 EXTERNAL SIMPLE INTEGER PROCEDURE RFONT(INTEGER F) ; TES 11/29/73 ;
00100 COMMENT T H E L I N E F I L L E R
00200
00300 These routines build a first pass output line in string OWL
00400 and then call the line placer (PLACELINE()) to place it in an area.
00500 OWL is kept lengthy enough to hold any first pass output line.
00600 That way, a line can be constructed by IDPB'ing (with APPEND())
00700 inside OWL instead of by numerous concatenations.
00800 Characters in OWL[1 TO OAKS] belong to the current line being
00900 built. However, some of these characters describe FONT changes or
01000 forward label references and others mark word breaks or CR to the
01100 left margin for superimposing. Thus, the line reaches only to
01200 column POSN (relative to the left edge of the area), and FAKE of
01300 these columns are not occupied but are only allocated for forward
01400 references. Furthermore, in FILL mode, the last permissible point
01500 after which the line can be broken by a CrLf is marked by four
01600 variables: BRKPT, BRKPOSN, BRKSPCS, and BRKFAKE, which contain the
01700 values of OAKS, POSN, and FAKE at that point, and the number of
01800 delible spaces right after that point. Though there is normally a
01900 WDBRK character at the breakpoint, there may be none if it is the
02000 first breakpoint on the line or if it was caused by a hyphen.
02100 TEXTLINE sets up the input stream for processing by PROCESS.
02200 PROCESS scans it up to a {, cr, or altmode, obeying all control
02300 characters and EMITting all regular characters. EMIT calls APPEND
02400 after checking for line overflow, etc. Spaces are PROCESSed
02500 differently -- instead of calling EMIT to APPEND them immediately,
02600 EMSPACES is called, which just counts up spaces in SPCS and handles
02700 COMPACTion and punctuation problems. Thus, when EMIT is called, it
02800 must append SPCS spaces before appending its argument. ;
02900
03000 SIMPLE PROCEDURE APPEND(STRING CHARS) ;
03100 IF ON THEN
03200 BEGIN "APPEND"
03300 STRING D ; INTEGER CCT, BALANCE ;
03400 DEFINE SRC="'15", COUNT="'14", DEST="'13", CHAR="'11" ;
03500 CCT ← LENGTH(CHARS) ;
03600 IF (BALANCE ← LENGTH(OWL) - (OAKS+CCT)) < 0 THEN
03700 OWL ← OWL & SPS((1-BALANCE)*2) ;
03800 IF CCT > 0 THEN
03900 BEGIN
04000 LABEL IUD ; COMMENT DEPOSIT LOOP ;
04100 D ← OWL[OAKS+1 FOR 1] ;
04200 START_CODE "APPD"
04300 MOVE SRC, CHARS ;
04400 HRRZ COUNT, CCT ;
04500 ADDM COUNT, OAKS ;
04600 MOVE DEST, D ;
04700 IUD: ILDB CHAR, SRC ;
04800 IDPB CHAR, DEST ;
04900 SOJG COUNT, IUD ;
05000 END "APPD"
05100 END ;
05200 END "APPEND" ;
00100 INTERNAL STRING SIMPLE PROCEDURE LABELREF(INTEGER USYMB, LEN) ;
00200 IF ¬ON THEN RETURN(NULL) ELSE
00300 BEGIN "LABELREF"
00400 INTEGER PTR, PLIGHT, WASSYMB ; STRING S ;
00500 IF NULSTR(THISWD) THEN ie, Generated Label for {PAGE}. USYMB=0.;
00600 PTR ← (PLBL ← PUTI(1, PLBL)) LOR TWO(14) ie Add to Linked List ;
00700 ELSE IF BYTEWD ← NUMBER[ PTR ← SYMNUM(THISWD & ":") ] THEN
00800 BEGIN "KNOWN LABEL"
00900 CASE (PLIGHT ← LDB(PLIGHTWD(BYTEWD))) MOD 3 OF
01000 BEGIN COMMENT BY PLIGHT ;
01100 ie 0 or 3 ... Page Label still Uncertain ; WASSYMB ← SYMPAGE ;
01200 ie 1 ... Referenced but not defined ; WASSYMB ← LDB(IXWD(BYTEWD)) ;
01300 ie 2 ... Defined and Certain ;
01400 BEGIN
01500 BREAKSET(LOCAL_TABLE,ALTMODE,"IS");
01600 BREAKSET(LOCAL_TABLE,NULL,"O");
01700 S ← STBL[LDB(IXWD(BYTEWD))] ;
01800 RETURN (SCAN(S,LOCAL_TABLE,DUMMY));
01900 END;
02000 END ; COMMENT BY PLIGHT ;
02100 IF USYMB AND LDB(IXN(USYMB)) ≠ LDB(IXN(WASSYMB)) THEN
02200 BEGIN "DIFFERENT UNIT"
02300 IF WASSYMB THEN WARN("X-REF ERROR","Label "&SYM[PTR]&
02400 " was cross-referenced as a "&SYM[WASSYMB]&
02500 " earlier, but now as a "&SYM[USYMB]) ;
02600 IF PLIGHT = 1 THEN NUMBER[PTR] ← 1 ROT -2 LOR USYMB ;
02700 END "DIFFERENT UNIT" ;
02800 END "KNOWN LABEL"
02900 ELSE NUMBER[PTR] ← 1 ROT -2 LOR USYMB ;
03000 RETURN(RUBOUT & CVS(LEN) & VT & CVS(PTR) & VT) ;
03100 END "LABELREF" ;
03200
03300 INTERNAL SIMPLE STRING PROCEDURE PICKFONT(INTEGER F) ; TES 11/15/73 11/29/73 ;
03400 RETURN(FONTCHAR&"F"&(IF F<10 THEN (F+"0") ELSE (F+("A"-10))));
00100 SIMPLE PROCEDURE OKSP(BOOLEAN EVEN_BEFORE_LMARG) ;
00200 IF LASTWDBRK ≠ OAKS AND ON AND
00300 JUSTIFY AND (POSN<MAXIM OR XCRIBL) AND (EVEN_BEFORE_LMARG OR POSN > 0 MAX INDENT) THEN
00400 BEGIN APPEND(WDBRK) ; LASTWDBRK ← OAKS ; END ;
00500
00600 SIMPLE PROCEDURE OKCR(BOOLEAN EVEN_IN_SUPERSUBSCRIPT) ;
00700 IF BRKPT≠OAKS AND ON AND (SUPERSUB=0 OR EVEN_IN_SUPERSUBSCRIPT) THEN
00800 BEGIN
00900 BRKPT ← OAKS ; BRKPOSN ← POSN ; BRKFAKE ← FAKE ; BRKPLBL ← PLBL ; BRKSPCS ← 0 ;
01000 BRKFONT ← THISFONT ; TES 11/16/73 ;
01100 BRKXPOSN ← XPOSN - FSHORT ;
01200 IF SUPERSUB THEN RETURN ;
01300 BRKABX ← BRKABX MAX ABOVEX ; BRKBLX ← BRKBLX MIN BELOWX ; ABOVEX←BELOWX←0 ;
01400 END "OKCR" ;
01500
01600 INTERNAL INTEGER SIMPLE PROCEDURE XLENGTH(STRING CHARS);
01700 BEGIN "XL"
01800 INTEGER COUNT;
01900 IF NOT XCRIBL THEN RETURN(0); COMMENT IF NOT IN XCRIBL MODE THEN WE DON'T NEED THIS VALUE;
02000 COUNT←0;
02100 WHILE FULSTR(CHARS) DO
02200 COUNT ← COUNT + CW[LOP(CHARS)];
02300 RETURN (COUNT);
02400 END;
02500
02600 INTEGER SIMPLE PROCEDURE XSPLEN(INTEGER N);
02700 RETURN(N * CW[SP]);
03040
03060 RECURSIVE PROCEDURE EMITPIECE(STRING CHARS; INTEGER NCHARS, XCHARL) ;
03100 BEGIN TES PROCEDURIZED 11/29/73 ;
03200 INTEGER EXCHARS, WASBRC ; STRING EXCESS ; LABEL ADDIT ; comment Sorry about that ;
03300 INTEGER XSPCL,XEXCHARS; RKJ;
03600 XSPCL ← XSPLEN(SPCS) ; RKJ;
03700 RKJ: OLD LINE IF POSN + SPCS + NCHARS ≤ MAXIM THEN comment, no overfow ;
03800 IF (IF XCRIBL THEN (XPOSN+XSPCL+XCHARL≤(MAXIM*CHARW)) ELSE (POSN+SPCS+NCHARS≤MAXIM)) THEN comment no overflow;
03900 ADDIT:
04000 BEGIN
04100 IF SPCS AND XCRIBL AND (FILL AND ADJUST) AND POSN>INDENT THEN
04200 BEGIN FSHORT←FSHORT+XSPLEN(1); SPCS←SPCS-1 END;
04300 IF SPCS THEN BEGIN APPEND(SPS(SPCS)) ; BRKSPCS ← SPCS END ;
04400 APPEND(CHARS) ; POSN ← POSN + SPCS + NCHARS ; SPCS ← 0 ;
04500 XPOSN ← XPOSN + XSPCL + XCHARL; RKJ;
04600 END
04700 ELSE IF FILL AND (BRKPT>INDENT OR BRKPOSN>INDENT) THEN comment, go back to a break point ;
04800 BEGIN
04900 IF BRKPT=OAKS THEN BEGIN XSPCL ← SPCS ← EXCHARS ← 0 ; EXCESS ← NULL END
05000 ELSE BEGIN EXCESS←OWL[BRKPT+1+BRKSPCS TO OAKS]; COPY(EXCESS);
05100 XEXCHARS ← XPOSN-FSHORT-BRKXPOSN-BRKSPCS*XSPLEN(1);
05200 EXCHARS←POSN-BRKPOSN-BRKSPCS END;
05300 FAKE ← FAKE - BRKFAKE ; NOPGPH ← -1 ; WASBRC ← BRC ;
05400 OAKS ← BRKPT ; BOUND(3) ; COMMENT ADDED 4/14/72 ;
05500 PLACELINE(IF OWL[OAKS FOR 1]=WDBRK ∧ LASTWDBRK=OAKS COMMENT JAN 9 73 ;
05600 THEN OAKS-1 ELSE OAKS, BRKPOSN MIN MAXIM, BRKXPOSN,
05700 BRKFAKE, BRKABX, -BRKBLX, IF FIRST THEN LEADFM ELSE SPREADM-1,
05800 BRKPLBL, ADJUST, SPREADM) ;
05900 FSHORT ← NOPGPH ← OAKS ← TABI ← BRKABX ← BRKBLX ← STARPOSN ← AMPPOSN ← LASTWDBRK ← 0 ; BRC←WASBRC;
06000 IF FIRST THEN BEGIN
06100 INDENT ← RESTIM MAX -LMARG ; FIRST ← FALSE ;
06200 END ;
06300 IF XCRIBL
06400 THEN
06500 BEGIN
06600 APPEND(PICKFONT(BRKFONT)) ; BRKFONT ← THISFONT ; TES 11/16/73 ;
06700 IF (LMARG+INDENT)≠0 THEN APPEND(FONTCHAR&"="&CVSR("CHARW*(LMARG+INDENT)"));
06800 XPOSN←CHARW*INDENT;
06900 END
07000 ELSE
07100 BEGIN
07200 APPEND(SPS(LMARG+INDENT));
07300 END;
07400 POSN←INDENT; OKCR(TRUE);
07500 IF UNDERLINING THEN APPEND(FONTCHAR&"_");
07600 APPEND(EXCESS);
07700 POSN←POSN+EXCHARS; XPOSN←XPOSN+XEXCHARS;
07800 IF SPCS THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ;
07900 GO TO ADDIT ;
08000 END
08100 ELSE IF POSN≤MAXIM THEN comment, About to overflow right edge of area! ;
08200 BEGIN
08300 APPEND((SPS(SPCS)&CHARS)[1 TO MAXIM - POSN]) ;
08400 IF XCRIBL AND FONTFIL[DEFAULTFONT]=0 THEN TES 11/15/73;
08500 WARN("=", "FONT declaration needed. Start over!")
08600 ELSE
08700 WARN("Line too long","Line too long -- characters lost:"&CHARS[MAXIM-POSN+1 TO ∞]&"...") ;
08800 POSN ← MAXIM+1 ; SPCS ← 0 ;
08900 XPOSN ← XMAXIM + 1; RKJ;
09000 END ;
09100 MIDWORD ← MIDWORD OR FULSTR(CHARS) ; PUNC ← FALSE ;
09200 END "EMITPIECE" ;
09300
09400 RECURSIVE PROCEDURE EMIT(STRING CHARS) ;
09500 IF ON THEN EMITPIECE(CHARS, LENGTH(CHARS), XLENGTH(CHARS)) ;
00100 INTEGER XLBFAKE; RKJ: FOR FORWARD REFERENCES IN BOUNDED ITEMS ;
00200 RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;
00300 IF ON THEN
00400 BEGIN
00500 INTEGER LB, RB, DEST, FILLIN, XLB, XFILLIN ;
00600 LABEL SLIDEFILL, TABFILL, TABCASE ; STRING FILLER, BOUNDS ;
00700 STRING SEGMENT ;
00800 COMMENT KIND ≤ 0 ... ∞X (The ASCII of X negated)
00900 = 1 ... ←
01000 = 2 ... →
01100 = 3 ... CR or BREAK
01200 = 4 ... Tab (\ or ∂) ;
01300 IF KIND=3 OR KIND=4 AND NULSTR(LBF) THEN SPCS ← 0 ELSE EMIT(NULL) ;
01400 OKCR(TRUE) ; comment added 4/17/72 ;
01500 Comment An earlier BOUND on this line may have set LBK←KIND ;
01600 IF LBK < 3 THEN CASE LBK MAX 0 OF
01700 BEGIN COMMENT BY KIND ;
01800 ie ≤ 0 ... ∞ Only valid if immediately preceding this Bound ;
01900 IF LBO < OAKS ∨ SPCS THEN
02000 BEGIN
02100 WARN("=","∞ needs a right bound") ;
02200 LBF ← NULL ;
02300 END ;
02400 ie = 1 ... ← Center between left bound at POSN=LBP and this TAB to RBOUND, or between margins ;
02500 BEGIN "CENTER"
02600 IF KIND=4 THEN BEGIN XLB←XLBP ; LB←LBP ; RB←RBOUND END
02700 ELSE BEGIN LB←XLB←0 ; RB←RMARG-LMARG END ;
02800 BOUNDS ← CVSR("(LMARG+RB)*(IF XCRIBL THEN CHARW ELSE 1)") & CVSR("(LMARG+LBP-LB)*(IF XCRIBL THEN CHARW ELSE 1)");
02900 FILLIN ← ((RB - POSN) - (LBP - LB)) DIV 2 ; COMMENT UPPER BOUND ESTIMATE ;
03000 SLIDEFILL:
03100 XFILLIN ← XPOSN - XLBP -(FAKE-XLBFAKE) ; COMMENT LENGTH OF PIECE ;
03200 SEGMENT ← OWL[LBO+1 TO OAKS] ; COPY(SEGMENT) ; OAKS ← LBO ; FILLER ← OLBF ;
03300 TABFILL:
03400 APPEND(FONTCHAR & "→") ; APPEND(BOUNDS) ;
03500 IF XCRIBL THEN
03600 BEGIN
03700 RKJ ; APPEND(CVSR(XFILLIN)) ;
03800 TES ; APPEND(CVSR("(FILLIN*CHARW)/XLENGTH(FILLER)")) ;
03900 END ;
04000 APPEND(FILLER & ALTMODE) ;
04100 APPEND(SEGMENT) ; APPEND(FONTCHAR & "←") ;
04200 POSN ← POSN + (FILLIN MAX 0) ;
04300 XPOSN ← XPOSN + (XFILLIN MAX 0) ;
04400 END "CENTER" ;
04500 ie 2 ... → Right flush against TAB to RBOUND or against right margin ;
04600 BEGIN "RIGHT FLUSH"
04700 RB ← IF KIND=4 THEN RBOUND ELSE RMARG-LMARG ;
04800 FILLIN ← RB - POSN ;
04900 BOUNDS ← CVSR("(LMARG+RB)*(IF XCRIBL THEN CHARW ELSE 1)") & CVSR("(IF XCRIBL THEN (-CHARW*1000) ELSE -1000)") ;
05000 GO TO SLIDEFILL ;
05100 END "RIGHT FLUSH" ;
05200 END ; COMMENT BY KIND ;
05300 IF KIND=3 ∧ FULSTR(LBF) THEN BEGIN RBOUND ← RMARG ; GO TO TABCASE END ;
05400 IF KIND=4 THEN
05500 BEGIN "TAB"
05600 IF FULSTR(LBF) THEN
05700 TABCASE: BEGIN
05800 FILLIN ← RBOUND - POSN ; BOUNDS ← CVSR(LMARG+RBOUND) & CVSR(-1000) ;
05900 FILLER ← LBF ; SEGMENT ← NULL ; KIND ← KIND + 2 ; GO TO TABFILL ;
06000 END
06100 ELSE APPEND(FONTCHAR&"="&CVSR("IF XCRIBL THEN CHARW*(RBOUND+LMARG) ELSE RBOUND+LMARG"));
06200 BRKXPOSN←BRKXPOSN+FSHORT; FSHORT←0;
06300 POSN ← RBOUND ; XPOSN ← RBOUND * CHARW ;
06400 END "TAB" ;
06500 IF KIND > 4 THEN KIND ← KIND - 2 ; COMMENT CORRECTS `KIND←KIND+2' ABOVE ↑↑↑↑↑↑↑ ;
06600 IF KIND = 4 AND POSN > MAXIM THEN MAXIM ← NMAXIM+LMARG
06700 ELSE IF FILL THEN MAXIM ← IF KIND ≤ 2 THEN NMAXIM ELSE FMAXIM ;
06800 IF KIND = 3 THEN LBP ← LBO ← 0 ELSE
06900 BEGIN
07000 comment Finally, set Left Bound for a subsequent BOUND ;
07100 LBO ← OAKS ; LBP ← POSN ; XLBP ← XPOSN ; LBK ← KIND ; MIDWORD ← FALSE ;
07200 XLBFAKE ← FAKE ;
07300 CASE ((KIND+1) MAX 0) DIV 2 OF BEGIN LBF←LBF&(-KIND) ; BEGIN OLBF←LBF ; LBF←NULL END ; OLBF←LBF←NULL END ;
07400 END ;
07500 END "BOUND" ;
00100 INTERNAL RECURSIVE PROCEDURE DBREAK ;
00200 IF ON THEN IF NOPGPH THEN NOPGPH ← -1 ELSE
00300 BEGIN INTEGER STTS ;
00400 NOPGPH ← -1 ;
00500 BOUND(3) ;
00600 IF POSN > INDENT OR VERBATIM THEN
00700 BEGIN "A PGPH"
00800 PLACELINE(IF LASTWDBRK=OAKS THEN OAKS-1 ELSE OAKS, POSN MIN MAXIM, MAXIM*CHARW-FSHORT,
00900 FAKE, ABOVEX MAX BRKABX,
01000 -(BELOWX MIN BRKBLX),
01100 IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1,
01200 PLBL, IF XCRIBL AND ADJUST THEN TRUE ELSE JUSTJUST, 0) ;
01300 FSHORT ← SINCELFM ← 0 ;
01400 IF ENDCASE=2 THEN BEGIN STTS←STARTS; IF ENDBLOCK THEN WARN("=","Missed END in Response|Footnote");
01500 STARTS ← STARTS + STTS ; END ;
01600 END "A PGPH" ;
01700 END "DBREAK" ;
01800
01900 SIMPLE PROCEDURE EMSPACES(INTEGER N) ;
02000 IF ON THEN BEGIN
02100 IF SPCS=0 THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ; MIDWORD ← FALSE ;
02200 SPCS ← IF COMPACT THEN (SPCS+N) MIN (IF PUNC THEN 2 ELSE 1) ELSE SPCS+N ;
02300 END "EMSPACES" ;
02400
02500 RECURSIVE PROCEDURE TABTO(INTEGER POSNO) ;
02600 IF ON THEN
02700 IF FULSTR(LBF) TES 11/1/73; AND (IF XCRIBL THEN (POSNO*CHARW ≤ XPOSN) ELSE (POSNO≤POSN))
02800 THEN WARN("=","Already passed tab column " & CVS(POSNO))
02900 ELSE IF POSNO>NMAXIM+LMARG AND NOT XCRIBL THEN
03000 WARN("=","No such tab column "&(IF POSNO>TWO(15) THEN NULL ELSE CVS(POSNO)))
03100 ELSE
03200 BEGIN
03300 RBOUND ← POSNO-1 ;
03400 IF TRUE COMMENT NOFILL ; THEN BOUND(4)
03500 ELSE BEGIN
03600 APPEND(FONTCHAR&"="&CVSR("IF XCRIBL THEN CHARW*(RBOUND+LMARG) ELSE RBOUND+LMARG"));
03700 POSN←RBOUND;
03800 END ;
03900 END "TABTO" ;
04000
04100 RECURSIVE BOOLEAN PROCEDURE ATLEAD(INTEGER LEADSPACES) ;
04200 BEGIN
04300 IF FINDINSET(LEADSPACES) AND FULSTR("SSTK[BODY(LLTHIS)]")THEN RESPOND(LLTHIS)
04400 ELSE RETURN(FALSE) ;
04500 RETURN(TRUE) ;
04600 END "ATLEAD" ;
04700
04800 BOOLEAN SIMPLE PROCEDURE SIGNA(INTEGER SIGCH1) ;
04900 BEGIN
05000 INTEGER ARG, RIX, ARGS, SEPS ; STRING SEE ;
05100 SEE ← SIGCH1 & INPUTSTR ;
05200 LLSCAN(SIGNALD[SIGCH1], NEXT_RESP, "CVASC(SEE[1 FOR CLUE(LLTHIS)])=SIGNAL(LLTHIS)") ;
05300 IF LLTHIS = 0 THEN RETURN(FALSE) ; RIX ← LLTHIS ; ARGS ← NUMARGS(RIX) ;
05400 INPUTSTR ← INPUTSTR[CLUE(RIX) TO ∞] ;
05500 IF ARGS THEN BEGIN "SCAN ARGS"
05600 SEPS ← RESP_SEP(RIX) ; IF LAST + ARGS > SIZE THEN GROWNESTS ;
05700 FOR ARG ← 1 THRU ARGS DO
05800 BEGIN "SEPBREAK"
05900 SETBREAK(LOCAL_TABLE,
06000 (SEPS LSH ((ARG-ARGS)*7) LAND '177) & CRLF, NULL, "IS") ;
06100 SEE ← NULL ;
06200 DO BEGIN
06300 SEE ← SEE & RD(LOCAL_TABLE) ;
06400 IF BRC = CR THEN
06500 BEGIN
06600 IF FULSTR("RD(TO_NON_SP)") ∨ BRC≠RCBRAK
06700 ∨ INPUTSTR[2 FOR 1]≠VT THEN DONE ;
06800 LOPP(INPUTSTR) ; LOPP(INPUTSTR) ; IF FULSTR(SEE) THEN SEE ← SEE & SP ;
06900 END
07000 ELSE BRC ← -1 ;
07100 END UNTIL BRC < 0 ;
07200 SNEST[LAST + ARG] ← SEE ;
07300 IF BRC > 0 THEN
07400 BEGIN
07500 WARN("=","Missing Signal Separator") ;
07600 FOR ARG ← ARG+1 THRU ARGS DO SNEST[LAST+ARG] ← NULL ;
07700 END ;
07800 END "SEPBREAK" ;
07900 IF ON THEN LAST ← LAST + ARGS ; COMMENT "IF" JAN 9 1973 ;
08000 END "SCAN ARGS" ;
08100 RESPOND(RIX) ; RETURN(TRUE) ;
08200 END "SIGNA" ;
00100 SIMPLE PROCEDURE UNSCRIPT(INTEGER ARROW) ;
00200 BEGIN
00300 INTEGER CHR, PN ; BOOLEAN MORE, WILLRIPT ;
00400 IF ARROW = 0 THEN
00500 BEGIN COMMENT "]" -- find matching "[" ;
00600 ARROW ← SUPERSUB LAND '177 ;
00700 AMPPOSN ← AMPPOSN LSH -9 ; COMMENT 3/28/72 ;
00800 SUPERSUB ← SUPERSUB LSH -9 ;
00900 END ;
01000 IF POSN ≤ MAXIM OR XCRIBL THEN
01100 BEGIN
01200 EMIT(NULL) ;
01300 IF ARROW ≠ "." THEN
01400 BEGIN
01500 APPEND(FONTCHAR & ("↑"+"↓" - ARROW)) ;
01600 HEIGHT ← HEIGHT - (IF ARROW="↑" THEN 1 ELSE -1) ;
01700 END ;
01800 END ;
01900 WILLRIPT ← TRUE ; comment assume that RIPTPOSNS will be updated by SCRIPT if necessary ;
02000 IF LDB(SPCODE(INPUTSTR)) = AMSAND THEN
02100 BEGIN
02200 LOPP(INPUTSTR) ;
02300 MORE ← TRUE ; PN ← RIPTPOSNS LAND '177 - LMARG ; COMMENT 3/28/72: ;
02400 AMPPOSN ← ((AMPPOSN LSH -9) LSH 9) LOR ((AMPPOSN LAND '177) MAX POSN) ;
02500 IF PN<POSN THEN BEGIN APPEND(FONTCHAR&"-"&CVSR(POSN-PN)) ; POSN←PN END ;
02600 IF (CHR ← LDB(SPCODE(INPUTSTR))) = LBRACK THEN
02700 BEGIN
02800 SUPERSUB ← SUPERSUB LSH 9 LOR "." ;
02900 LOPP(INPUTSTR) ; WILLRIPT ← FALSE ; comment not a ript: won't call SCRIPT! ;
03000 END
03100 ELSE IF CHR≠UARROW AND CHR≠DARROW THEN BEGIN EMIT(LOP(INPUTSTR)) ; MORE ← FALSE END ;
03200 END
03300 ELSE MORE ← FALSE ;
03400 IF ¬MORE THEN BEGIN COMMENT 3/28/72: ;
03500 PN ← (AMPPOSN LAND '177) MAX POSN ; AMPPOSN ← (AMPPOSN LSH -9) LSH 9 ;
03600 IF PN>POSN THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(PN-POSN)) ; POSN←PN END END ;
03700 IF WILLRIPT THEN RIPTPOSNS ← RIPTPOSNS LSH -9 ;
03800 END "UNSCRIPT" ;
03900
04000 SIMPLE PROCEDURE SCRIPT(INTEGER ARROW) ;
04100 BEGIN
04200 INTEGER CHR ;
04300 CHR ← LOP(INPUTSTR) ;
04400 HEIGHT ← HEIGHT + (IF ARROW="↑" THEN 1 ELSE -1) ;
04500 ABOVEX ← ABOVEX MAX HEIGHT ; BELOWX ← BELOWX MIN HEIGHT ;
04600 IF POSN ≤ MAXIM OR XCRIBL THEN BEGIN EMIT(NULL) ; APPEND(FONTCHAR&ARROW) ; END ;
04700 RIPTPOSNS ← RIPTPOSNS LSH 9 LOR (POSN+LMARG) ;
04800 IF LDB(SPCODE(CHR))=LBRACK THEN BEGIN SUPERSUB ← SUPERSUB LSH 9 LOR ARROW ;
04900 AMPPOSN ← AMPPOSN LSH 9 ; COMMENT 3/28/72 ; END
05000 ELSE BEGIN EMIT(CHR) ; UNSCRIPT(ARROW) END ;
05100 END "SCRIPT" ;
00100 RECURSIVE PROCEDURE PROCESS ;
00200 BEGIN
00300 INTEGER N, CHR, F, INSET ; BOOLEAN PLUS, DONE ; STRING PIECE ; LABEL ENDERLINE ;
00400 EMPTYTHIS ; INSET ← 0 ;
00500 IF INPUTSTR = VT THEN IF ¬ON THEN LOPP(INPUTSTR) ELSE
00600 BEGIN "NEW INPUT LINE"
00700 LOPP(INPUTSTR) ;
00800 IF VERBATIM THEN BEGIN END
00900 ELSE IF INPUTSTR=CR ∧ (N←SIGNALD[CR]) THEN BEGIN LOPP(INPUTSTR) ; RESPOND(N) ; RETURN END
01000 ELSE IF ATLEAD(INSET ← LENGTH(RD(TO_NON_SP))) THEN INSET←0 ; comment AT NULL , AT <integer> ;
01100 END "NEW INPUT LINE" ;
01200 IF NOPGPH ∧ ON THEN ie, First line of paragraph ;
01300 BEGIN "START PARAGRAPH"
01400 OAKS←SPCS←TABI←PUNC←MIDWORD←SUPERSUB←ABOVEX←BELOWX←HEIGHT←FAKE←BRKABX←BRKBLX←UNDERLINING←0 ;
01500 FIRST ← NOFILL ∨ NOPGPH<0 ; STARPOSN←AMPPOSN←LASTWDBRK←0 ;
01600 BRKFONT ← THISFONT ; TES 11/16/73 ;
01700 INDENT ← IF FLUSHL∨VERBATIM∨CENTER∨FLUSHR THEN 0
01800 ELSE (IF NOFILL OR FIRST THEN FIRSTIM ELSE RESTIM) MAX -LMARG ;
01900 NOPGPH ← 0 ; LBK ← 3 ; LBF ← NULL ;
02000 IF XCRIBL
02100 THEN
02200 BEGIN
02300 APPEND(PICKFONT(THISFONT)) ; TES 11/15/73 ;
02400 IF (LMARG+INDENT)≠0 THEN APPEND(FONTCHAR&"="&CVSR("CHARW*(LMARG+INDENT)"));
02500 XPOSN←CHARW*INDENT;
02600 END
02700 ELSE
02800 BEGIN
02900 APPEND(SPS(LMARG+INDENT));
03000 END;
03100 POSN←INDENT; FSHORT←0; OKCR(TRUE);
03200 IF FLUSHR THEN BOUND(2) ELSE IF CENTER THEN BOUND(1) ;
03300 FMAXIM ← (RMARG-RIGHTIM)-LMARG ;
03400 NMAXIM ← COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT) - LMARG ;
03500 MAXIM ← IF FILL THEN FMAXIM ELSE NMAXIM ;
03600 IF VERBATIM THEN BEGIN JUSTIFY←FALSE; EMIT(RD(TO_CR_SKIP)); DBREAK ; RETURN END ;
03700 END "START PARAGRAPH" ;
03800 JUSTIFY ← FILL∧ADJUST ∨ JUSTJUST ; DONE ← FALSE ; IF INSET∧RETAIN∧¬FLUSHL THEN EMSPACES(INSET) ;
03900 DO BEGIN "SCAN TEXT"
04000 IF FULSTR("PIECE ← RD(TEXT_TBL)") THEN EMIT(PIECE) ;
04100 IF BRC≠CR ∧ SIGNALD[BRC] ∧ SIGNA(BRC) THEN BEGIN COMMENT Responded to signal ; END
04200 ELSE CASE CHARTBL[BRC] LAND '77 OF
04300 BEGIN COMMENT BY BRC ;
04400 ie 0 ; EMIT(BRC) ;
04500 ie 1 ... CR ; BEGIN SUPERSUB←HEIGHT←AMPPOSN←RIPTPOSNS←0 ;
04600 IF FILL ∧ CRSPACE THEN EMSPACES(IF SPCS ∨ ¬POSN THEN 0 ELSE IF PUNC THEN 2 ELSE 1)
04700 ELSE IF IMPOSE THEN
04800 BEGIN "SUPERIMPOSE"
04900 IF (N ← SINCELFM+1) > TWEENLFM THEN DBREAK
05000 ELSE BEGIN EMIT(NULL); APPEND(CR & SPS(LMARG+(POSN←INDENT))); SINCELFM ← N ;
05100 TABI←MIDWORD←STARPOSN←FAKE←0 ; LBK←3; LBF←NULL; OKCR(FALSE) END ;
05200 END "SUPERIMPOSE"
05300 ELSE DBREAK ;
05400 DONE ← TRUE ;
05500 END ;
05600 ie 2 ... Altmode or { ; DONE ← TRUE ;
05700 ie 3 ... Rubout;IF ON THEN
05800 BEGIN "LABEL REF"
05900 N ← CVD(SCAN(INPUTSTR,TO_VT_SKIP,F)) ;
06000 IF XCRIBL THEN
06100 BEGIN
06200 EMIT(S←"01234567890123456789012345678901234567890123456789"[1 FOR N]);
06300 FAKE←FAKE+XLENGTH(S);
06400 END
06500 ELSE
06600 BEGIN
06700 EMIT(SPS(N)); FAKE←FAKE+N;
06800 END;
06900 OAKS←OAKS-N;
07000 APPEND(VT&SCAN(INPUTSTR, TO_VT_SKIP, F)&ALTMODE) ;
07100 END "LABEL REF"
07200 ELSE FOR N ← 1,2 DO SCAN(INPUTSTR, TO_VT_SKIP, F) ;
07300 ie 4 ... α ; IF INPUTSTR≠ALTMODE THEN IF (N←LOP(INPUTSTR))=CR THEN DONE←TRUE
07400 ELSE BEGIN "CHKXGP"
07500 IF XCRIBL THEN
07600 IF (F←LDB(SPCODE(N))) = XCMDCHR
07700 THEN BEGIN EMIT(N); APPEND(N) END
07800 ELSE EMIT(N)
07900 ELSE EMIT(N);
08000 END "CHKXGP";
08100 ie 5 ... β ; IF FILL THEN OKCR(FALSE) ELSE EMIT(BRC) ;
08200 ie 6 ... # ; EMIT(SP) ;
00100 ie 7 ... \ ; IF ON THEN BEGIN "NEXT TAB"
00200 POSN←POSN+SPCS; XPOSN←XPOSN+XSPLEN(SPCS); SPCS←0;
00300 DO BEGIN TABI←TABI+1; N←TABSORT[TABI] END
00400 UNTIL (IF XCRIBL THEN N*CHARW>XPOSN ELSE N>POSN);
00500 TABTO(N) ; IF N > NMAXIM+LMARG THEN TABI ← TABI - 1 ;
00600 END "NEXT TAB" ;
00700 ie 8 ... ∂ ; IF (CHR←INPUTSTR)=CR ∨ CHR=ALTMODE ∨ NULSTR(INPUTSTR) THEN EMIT(BRC)
00800 ELSE BEGIN "SPECIFIC TAB"
00900 SPCS←0 ;
01000 CHR ← LOP(INPUTSTR) ;
01100 IF (PLUS ← CHR)="+" ∨ CHR="-" THEN CHR ← LOP(INPUTSTR) ELSE PLUS←0 ;
01200 IF CHR="(" THEN
01300 BEGIN
01400 PASS ; N ← CVD(E("0",0)) ;
01500 IF ¬ITSCH(")") THEN WARN("=","Missed ) after ∂(...") ;
01600 END
01700 ELSE IF (F←LDB(FAMILY(CHR)))=0 THEN N←
01800 CVD(EVALV(SYM[N←SYMNUM(CHR)], LDB(IXN(N)), LDB(TYPEN(N))))
01900 ELSE IF F = DIGQ THEN N ← CHR - 48 comment, Digit ;
02000 ELSE BEGIN WARN("=","Unintelligible ∂ Construct") ; N ← 0 END ;
02100 IF PLUS="-" THEN
02200 BEGIN "BACKSPACE"
02300 EMIT(NULL) ; STARPOSN ← POSN MAX STARPOSN ;
02400 IF XCRIBL THEN
02500 BEGIN
02600 APPEND(FONTCHAR&'35&LOP(INPUTSTR));
02700 IF N ≠ 1 THEN
02800 WARN("=","Can't backspace more than one!!");
02900 END
03000 ELSE
03100 BEGIN
03200 POSN ← POSN-N MAX 0 ;
03300 APPEND(FONTCHAR&PLUS&CVSR(N)) ;
03400 END;
03500 END
03600 ELSE IF PLUS="+" ∧ NULSTR(LBF) THEN
03700 BEGIN
03800 IF N>0 THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(IF XCRIBL THEN N*CHARW ELSE N));
03900 POSN←POSN+N MIN NMAXIM+LMARG END;
04000 END
04100 ELSE TABTO((IF PLUS="*" THEN STARPOSN ELSE
04200 IF PLUS="+" THEN POSN+N ELSE N) MIN NMAXIM+LMARG) ;
04300 END "SPECIFIC TAB" ;
04400 ie 9 ... ← ; IF LBK ≠ 2 THEN BOUND(1) ELSE EMIT(BRC) ;
04500 ie 10 ... → ; IF LBK ≠ 2 THEN BOUND(2) ELSE EMIT(BRC) ;
04600 ie 11 ... ∞ ; IF (N←INPUTSTR)=CR ∨ N=ALTMODE THEN WARN("=","∞ What?")
04700 ELSE BOUND(-LOP(INPUTSTR)) ;
04800 ie 12 ... ↑ ; IF ON ∧ (CHR←INPUTSTR)≠CR ∧ CHR≠ALTMODE THEN SCRIPT("↑") ELSE EMIT(BRC) ;
04900 ie 13 ... ↓ ; IF ON THEN IF (CHR←INPUTSTR)=CR ∨ CHR=ALTMODE THEN EMIT(BRC)
05000 ELSE IF LDB(SPCODE(INPUTSTR))=UNDERBAR THEN
05100 BEGIN
05200 LOPP(INPUTSTR) ; EMIT(NULL) ;
05300 IF POSN≤MAXIM OR XCRIBL THEN BEGIN IF UNDERLINING=0 THEN APPEND(FONTCHAR&"_"); UNDERLINING←2 END ;
05400 END
05500 ELSE SCRIPT("↓") ;
05600 ie 14 ... ] ; IF SUPERSUB AND ON THEN UNSCRIPT(0)
05700 ELSE EMIT(BRC) ;
00100 ie 15 ... hyphen ; IF MIDWORD AND FILL AND ON AND ¬SUPERSUB THEN
00200 BEGIN
00300 EMIT("-") ; OKCR(FALSE) ;
00400 IF INPUTSTR=CR THEN BEGIN LOPP(INPUTSTR); DONE←TRUE END ;
00500 END
00600 ELSE BEGIN N←MIDWORD ; EMIT(BRC) ; MIDWORD ← N END ;
00700 ie 16 ... .!? ; IF MIDWORD∧FILL∧ON∧¬SUPERSUB THEN BEGIN EMIT(BRC) ; PUNC←TRUE END
00800 ELSE EMIT(BRC) ;
00900 ie 17 ... space ; EMSPACES(1 + LENGTH(RD(TO_NON_SP)) ) ;
01000 ie 18 ... underline ; IF LDB(SPCODE(INPUTSTR))=DARROW AND ON THEN
01100 BEGIN
01200 LOPP(INPUTSTR) ; EMIT(NULL) ;
01300 IF UNDERLINING THEN
01400 ENDERLINE: BEGIN
01500 UNDERLINING ← 0 ;
01600 IF POSN≤MAXIM OR XCRIBL THEN APPEND(FONTCHAR&"≡") ;
01700 END ;
01800 END
01900 ELSE BEGIN
02000 EMIT(NULL) ;
02100 IF POSN≤MAXIM OR XCRIBL THEN
02120 EMIT(IF NULSTR(VUNDERLINE) THEN " " ELSE VUNDERLINE);
02200 COMMENT POSN< CHANGED TO POSN≤ ON 2/27/73 TES ;
02220 COMMENT EMIT(BRC) CHANGED TO USE VUNDERLINE 11/29/73 TES ;
02300 END ;
02400 ie 19 ... π ; IFC VERSION = 1000 THENC TES Eliminate later ;
02420 BEGIN
02500 IF (CHR ← INPUTSTR) = "g" THEN CHR ← "G" ;
02600 IF CHR="G" ∨ CHR="." ∨ CHR="∂" ∨ CHR="+" ∨ CHR="-" ∨ CHR="~" THEN
02700 BEGIN
02800 EMIT(NULL) ;
02900 IF ON ∧ (POSN<MAXIM OR XCRIBL) THEN
03000 BEGIN APPEND(FONTCHAR&"π") ; EMIT(CHR) END ;
03100 LOPP(INPUTSTR) ;
03200 END
03300 ELSE EMIT(BRC)
03400 END ;
03405 ELSEC TES 11/29/73 ;
03410 IF FULSTR(PIECE←PICHAR[CHR←INPUTSTR]) THEN
03415 BEGIN
03420 F ← LOP(PIECE) ; N ← LOP(PIECE) ;
03425 IF ON THEN
03430 EMITPIECE(FONTCHAR & "π" & LENGTH(PIECE) & PIECE,
03435 1,
03440 IF NOT XCRIBL THEN 0
03445 ELSE IF F='177 THEN CW[N]
03450 ELSE 128*F+N) ;
03455 LOPP(INPUTSTR) ;
03460 END
03465 ELSE EMIT(BRC) ;
03470 ENDC
03500 ie 20 ... ∪ ; IF ON ∧ UNDERLINING=0 THEN
03600 BEGIN COMMENT ∪NDERLINE ONE WORD ;
03700 EMIT(NULL) ; UNDERLINING ← 1 ;
03800 IF POSN<MAXIM OR XCRIBL THEN APPEND(FONTCHAR & "_") ;
03900 IF FULSTR("PIECE←RD(ALPHA)") THEN EMIT(PIECE) ;
04000 GO TO ENDERLINE ;
04100 END ;
04200 ie 21 ... ∩ ; EMIT(BRC) ; COMMENT CURRENTLY NOT USED ;
04300 ie 22 ... VT ; WARN("=", "`⊃' SEEMS TO BE ON TEXT LINE IN MACRO") ;
04400 ie 23 ... $ ; IF LDB(SPCODE(INPUTSTR))=LBRACK THEN
04500 BEGIN LOPP(INPUTSTR) ; DONE←TRUE END ELSE BEGIN WARN("=","!!") ;EMIT(BRC) ; END ;
04600 ie 24 ... % ; IF ON THEN
04700 BEGIN "PERCENT"
04800 CHR←LOP(INPUTSTR);
05200 IF CHR="*" THEN F←OLDFONT
05250 ELSE IF (F ← RFONT(CHR)) < 0 THEN TES 11/29/73 RFONT;
05300 BEGIN WARN("=","Illegal font `"&CHR&"'"); F←0 END;
05400 IF F>0 AND FONTFIL[F]=0 THEN
05500 BEGIN
05600 IF XCRIBL THEN TES 11/5/73 ;
05700 WARN("=","Unknown font `"&CHR&"'");
05800 F←0;
05900 END;
06000 IF F AND XCRIBL THEN
06100 BEGIN
06200 EMIT(NULL);
06300 IF F NEQ THISFONT THEN APPEND(PICKFONT(F)) ;
06400 SWITCHFONT(F) ; TES 11/15/73 SUBROUTINIZED ;
06500 END;
06600 END;
06700 ie 25 ... ⊗ ; EMIT(BRC) ; comment PASS 3 control only, no action here ;
06800 ie 26 ... [ ; EMIT(BRC) ; comment just to be safe ;
06900 ie 27 ... & ; EMIT(BRC) comment just to be safe ;
07000 END ; COMMENT BY BRC ;
07100 END "SCAN TEXT" UNTIL DONE ;
07200 END "PROCESS " ;
00100 INTERNAL RECURSIVE BOOLEAN PROCEDURE TEXTLINE ;
00200 BEGIN
00300 PRELOAD_WITH 6, [8]0, 1, [2]0, 5, 0, 3, [4]4, [6]0, 4, 2, 4, 2, [2]0 ;
00400 OWN INTEGER ARRAY TEXTTYPE[-15:15] ;
00500 BOOLEAN IMITEXT ; INTEGER USYMB, LEN ; STRING STR ;
00600 IMITEXT ← TRUE ; comment assume computed text line ;
00700 CASE TEXTTYPE[THISTYPE] OF
00800 BEGIN COMMENT BY TYPE ;
00900 ie 0 ... Invalid ; RETURN(FALSE) ;
01000 ie 1 ... [ ; BEGIN comment [Est] Label or [@] rubout gen-label ; PASS ;
01100 IF ITS(@) THEN BEGIN PASS ; IMITEXT ← FALSE END
01200 ELSE BEGIN LEN ← CVD(E("5", 0)) ; COMMENT THANKS RKJ ;
01300 IF ITSCH("]") THEN PASS ELSE WARN("=","Missed ] after label length") ;
01400 THISWD ← LABELREF(0, LEN) ; END ;
01500 END ;
01600 ie 2 ... Unit ; IF THATISID THEN
01700 BEGIN comment Unit Label ;
01800 USYMB ← SYMB ;
01900 LEN ← IF THISTYPE=PUNITTYPE THEN PATT_CHRS(IX) ELSE CTR_CHRS(IX) ;
02000 PASS ; THISWD ← LABELREF(USYMB, LEN) ;
02100 END
02200 ELSE IF IX=IXPAGE THEN
02300 BEGIN comment, Generate a label ;
02400 THISWD ← NULL ;
02500 THISWD ← LABELREF(0, IF ITS(PAGE) THEN CTR_CHRS(IXPAGE) ELSE PATT_CHRS(IXPAGE)) ;
02600 END
02700 ELSE THISWD ← VEVAL ;
02800 ie 3 ... Constant ;
02900 BEGIN
03000 LOPP(THISWD) ;
03100 IF THATISID ∧ SIMLOOK(CAPITALIZE(STR←SCAN(THISWD,ALPHA,DUMMY)))
03200 ∧ (SYMTYPE = UNITTYPE ∨ SYMTYPE = PUNITTYPE) THEN
03300 BEGIN comment "Unit.." Label ;
03400 IF SYMTYPE=PUNITTYPE THEN STR←STR[1 TO ∞-1]; USYMB ← SYMBOL;
03500 LEN ← IF SYMTYPE=PUNITTYPE THEN PATT_CHRS(SYMIX) ELSE CTR_CHRS(SYMIX) ;
03600 PASS ; THISWD ← STR & SP & LABELREF(USYMB, LEN) ;
03700 END ;
03800 END ;
03900 ie 4 ... Variable ; THISWD ← VEVAL ;
04000 ie 5 ... } etc. ; IF IX comment not } ; THEN RETURN(FALSE) ELSE IMITEXT←FALSE ;
04100 ie 6 ... misc ; IF ITSCH("(") THEN BEGIN PASS; STR←E(NULL,NULL);
04200 IF ¬ITSCH(")") THEN WARN("=","Parens don't match") ; THISWD←STR END ELSE RETURN(FALSE) ;
04300 END ; COMMENT BY TYPE ;
04400 IF IMITEXT THEN IF NULSTR(THISWD) OR ¬ON THEN ELSE
04500 BEGIN
04600 BEGINBLOCK(FALSE, 0, "!NAKED") ;
04700 SWICH(THISWD&ALTMODE&" END ""!NAKED""", -1, 0) ;
04800 PROCESS ;
04900 END
05000 ELSE PROCESS ;
05100 PASS ;
05200 RETURN(TRUE) ;
05300 END "TEXTLINE" ;
00100 END "INNER BLOCK" ;
00200 END "FILLER"